﻿#Region "Using"

Imports System.Xml
Imports System.Collections.Generic
Imports System.Collections.Specialized
Imports System.Configuration.Provider
Imports System.Web.Profile
Imports System.Web.Security
Imports System.Web.Hosting
Imports System.Web.Management
Imports System.Security.Permissions
Imports System.Web
Imports System.Text
Imports System.Security.Cryptography

#End Region

Public Class XmlMembershipProvider
    Inherits MembershipProvider
    Private _Users As Dictionary(Of String, MembershipUser)
    Private _XmlFileName As String
    Private _forceUpdate As Boolean
#Region "Properties"

    ' MembershipProvider Properties
    Public Overrides Property ApplicationName() As String
        Get
            Throw New NotSupportedException()
        End Get
        Set(ByVal value As String)
            Throw New NotSupportedException()
        End Set
    End Property

    Public Overrides ReadOnly Property EnablePasswordRetrieval() As Boolean
        Get
            Return False
        End Get
    End Property

    Public Overrides ReadOnly Property EnablePasswordReset() As Boolean
        Get
            Return False
        End Get
    End Property

    Public Overrides ReadOnly Property MaxInvalidPasswordAttempts() As Integer
        Get
            Return 5
        End Get
    End Property

    Public Overrides ReadOnly Property MinRequiredNonAlphanumericCharacters() As Integer
        Get
            Return 0
        End Get
    End Property

    Public Overrides ReadOnly Property MinRequiredPasswordLength() As Integer
        Get
            Return 8
        End Get
    End Property

    Public Overrides ReadOnly Property PasswordAttemptWindow() As Integer
        Get
            Throw New NotSupportedException()
        End Get
    End Property

    Public Overrides ReadOnly Property PasswordFormat() As MembershipPasswordFormat
        Get
            Return MembershipPasswordFormat.Clear
        End Get
    End Property

    Public Overrides ReadOnly Property PasswordStrengthRegularExpression() As String
        Get
            Throw New NotSupportedException()
        End Get
    End Property

    Public Overrides ReadOnly Property RequiresQuestionAndAnswer() As Boolean
        Get
            Return False
        End Get
    End Property

    Public Overrides ReadOnly Property RequiresUniqueEmail() As Boolean
        Get
            Return False
        End Get
    End Property

#End Region

#Region "Supported methods"

    Public Overrides Sub Initialize(ByVal name As String, ByVal config As NameValueCollection)
        If config Is Nothing Then
            Throw New ArgumentNullException("config")
        End If

        If [String].IsNullOrEmpty(name) Then
            name = "XmlMembershipProvider"
        End If

        If String.IsNullOrEmpty(config("description")) Then
            config.Remove("description")
            config.Add("description", "XML membership provider")
        End If

        MyBase.Initialize(name, config)

        ' Initialize _XmlFileName and make sure the path
        ' is app-relative
        Dim path As String = config("xmlFileName")

        If [String].IsNullOrEmpty(path) Then
            path = "~/App_Data/Users.xml"
        End If

        If Not VirtualPathUtility.IsAppRelative(path) Then
            Throw New ArgumentException("xmlFileName must be app-relative")
        End If

        Dim fullyQualifiedPath As String = VirtualPathUtility.Combine(VirtualPathUtility.AppendTrailingSlash(HttpRuntime.AppDomainAppVirtualPath), path)

        _XmlFileName = HostingEnvironment.MapPath(fullyQualifiedPath)
        config.Remove("xmlFileName")

        ' Make sure we have permission to read the XML data source and
        ' throw an exception if we don't
        Dim permission As New FileIOPermission(FileIOPermissionAccess.Write, _XmlFileName)
        permission.Demand()

        ' Throw an exception if unrecognized attributes remain
        If config.Count > 0 Then
            Dim attr As String = config.GetKey(0)
            If Not [String].IsNullOrEmpty(attr) Then
                Throw New ProviderException("Unrecognized attribute: " & attr)
            End If
        End If

        'ReadMembershipDataStore()
    End Sub

    ''' <summary>
    ''' Returns true if the username and password match an exsisting user.
    ''' </summary>
    Public Overrides Function ValidateUser(ByVal username As String, ByVal password As String) As Boolean
        If [String].IsNullOrEmpty(username) OrElse [String].IsNullOrEmpty(password) Then
            Return False
        End If

        Try
            ReadMembershipDataStore()

            ' Validate the user name and password
            Dim user As MembershipUser
            If _Users.TryGetValue(username, user) Then
                If user.Comment = Encrypt(password) Then
                    ' Case-sensitive
                    If user.IsApproved Then
                        user.LastLoginDate = DateTime.Now
                        UpdateUser(user)
                        Return True
                    End If
                End If
            End If

            Return False
        Catch ex As Exception
            Return False
        End Try
    End Function

    ''' <summary>
    ''' Retrieves a user based on his/hers username.
    ''' the userIsOnline parameter is ignored.
    ''' </summary>
    Public Overrides Function GetUser(ByVal username As String, ByVal userIsOnline As Boolean) As MembershipUser
        If [String].IsNullOrEmpty(username) Then
            Return Nothing
        End If

        ReadMembershipDataStore()

        ' Retrieve the user from the data source
        Dim user As MembershipUser
        If _Users.TryGetValue(username, user) Then
            Return user
        End If

        Return Nothing
    End Function

    ''' <summary>
    ''' Retrieves a collection of all the users.
    ''' This implementation ignores pageIndex and pageSize,
    ''' and it doesn't sort the MembershipUser objects returned.
    ''' </summary>
    Public Overrides Function GetAllUsers(ByVal pageIndex As Integer, ByVal pageSize As Integer, ByRef totalRecords As Integer) As MembershipUserCollection
        ReadMembershipDataStore()
        Dim users As New MembershipUserCollection()

        For Each pair As KeyValuePair(Of String, MembershipUser) In _Users
            users.Add(pair.Value)
        Next

        totalRecords = users.Count
        Return users
    End Function

    ''' <summary>
    ''' Changes a users password.
    ''' </summary>
    Public Overrides Function ChangePassword(ByVal username As String, ByVal oldPassword As String, ByVal newPassword As String) As Boolean
        Dim doc As New XmlDocument()
        doc.Load(_XmlFileName)
        Dim nodes As XmlNodeList = doc.GetElementsByTagName("User")
        For Each node As XmlNode In nodes
            If node("UserName").InnerText.Equals(username, StringComparison.OrdinalIgnoreCase) OrElse node("Password").InnerText.Equals(Encrypt(oldPassword), StringComparison.OrdinalIgnoreCase) Then
                node("Password").InnerText = Encrypt(newPassword)
                doc.Save(_XmlFileName)
                ReadMembershipDataStore()
                Return True
            End If
        Next

        Return False
    End Function

    ''' <summary>
    ''' Creates a new user store he/she in the XML file
    ''' </summary>
    Public Overrides Function CreateUser(ByVal username As String, ByVal password As String, ByVal email As String, ByVal passwordQuestion As String, ByVal passwordAnswer As String, ByVal isApproved As Boolean, _
     ByVal providerUserKey As Object, ByRef status As MembershipCreateStatus) As MembershipUser
        Dim users As MembershipUserCollection = GetAllUsers(1, 9999, 9999)
        Dim _badUser As Boolean = False
        For Each u As MembershipUser In users
            If u.Email = email Then
                status = MembershipCreateStatus.DuplicateEmail
                _badUser = True
                Exit For
            End If
            If u.UserName = username Then
                status = MembershipCreateStatus.DuplicateUserName
                _badUser = True
                Exit For
            End If
            'MembershipCreateStatus.InvalidEmail
            'MembershipCreateStatus.InvalidPassword
            'MembershipCreateStatus.InvalidUserName
        Next
        Dim user As MembershipUser = Nothing
        If Not _badUser Then
            Dim doc As New XmlDocument()
            doc.Load(_XmlFileName)
            Dim _now As DateTime = Now

            Dim xmlUserRoot As XmlNode = doc.CreateElement("User")
            Dim xmlUserName As XmlNode = doc.CreateElement("UserName")
            Dim xmlPassword As XmlNode = doc.CreateElement("Password")
            Dim xmlEmail As XmlNode = doc.CreateElement("Email")
            Dim xmlLastLoginTime As XmlNode = doc.CreateElement("LastLoginTime")
            Dim xmlIsApproved As XmlNode = doc.CreateElement("IsApproved")
            Dim xmlCreatedDate As XmlNode = doc.CreateElement("Created")

            xmlUserName.InnerText = username
            xmlPassword.InnerText = Encrypt(password)
            xmlEmail.InnerText = email
            xmlLastLoginTime.InnerText = _now.ToString("yyyy-MM-dd HH:mm:ss")
            xmlIsApproved.InnerText = isApproved
            xmlCreatedDate.InnerText = _now.ToString("yyyy-MM-dd HH:mm:ss")

            xmlUserRoot.AppendChild(xmlUserName)
            xmlUserRoot.AppendChild(xmlPassword)
            xmlUserRoot.AppendChild(xmlEmail)
            xmlUserRoot.AppendChild(xmlLastLoginTime)
            xmlUserRoot.AppendChild(xmlIsApproved)
            xmlUserRoot.AppendChild(xmlCreatedDate)

            doc.SelectSingleNode("Users").AppendChild(xmlUserRoot)
            doc.Save(_XmlFileName)

            status = MembershipCreateStatus.Success
            'Dim user As New MembershipUser(Name, username, username, email, passwordQuestion, Encrypt(password), _
            ' isApproved, False, _now, _now, _now, _now, _
            ' DateTime.MaxValue)
            user = New MembershipUser(Name, username, username, email, passwordQuestion, Encrypt(password), _
             isApproved, False, _now, _now, _now, _now, _
             DateTime.MaxValue)

            '---- Create Profile -------
            Dim p As ProfileBase = ProfileBase.Create(username)
            p.SetPropertyValue("FirstName", "") ' Have to set at least one of the profile values or else it will not create the XML file.
            p.Save()
            '---- Create Role Entry ------
            Roles.AddUserToRole(username, "Member") ' Have to add user to at least one role or they won't get any entry.
        End If
        '-----------
        Return user
    End Function

    ''' <summary>
    ''' Deletes the user from the XML file and 
    ''' removes him/her from the internal cache.
    ''' </summary>
    Public Overrides Function DeleteUser(ByVal username As String, ByVal deleteAllRelatedData As Boolean) As Boolean
        Dim doc As New XmlDocument()
        doc.Load(_XmlFileName)

        For Each node As XmlNode In doc.GetElementsByTagName("User")
            If node.ChildNodes(0).InnerText.Equals(username, StringComparison.OrdinalIgnoreCase) Then
                doc.SelectSingleNode("Users").RemoveChild(node)
                doc.Save(_XmlFileName)
                _Users.Remove(username)
                Return True
            End If
        Next

        Return False
    End Function

    ''' <summary>
    ''' Get a user based on the username parameter.
    ''' the userIsOnline parameter is ignored.
    ''' </summary>
    Public Overrides Function GetUser(ByVal providerUserKey As Object, ByVal userIsOnline As Boolean) As MembershipUser
        Dim doc As New XmlDocument()
        doc.Load(_XmlFileName)

        For Each node As XmlNode In doc.SelectNodes("//User")
            If node.ChildNodes(0).InnerText.Equals(providerUserKey.ToString(), StringComparison.OrdinalIgnoreCase) Then
                Dim userName As String = node.ChildNodes(0).InnerText
                Dim password As String = node.ChildNodes(1).InnerText
                Dim email As String = node.ChildNodes(2).InnerText
                Dim lastLoginTime As DateTime = DateTime.Parse(node.ChildNodes(3).InnerText)
                Dim isApproved As Boolean = CBool(node.ChildNodes(4).InnerText)
                Dim createdDt As DateTime = DateTime.Parse(node.ChildNodes(5).InnerText)
                Return New MembershipUser(Name, providerUserKey.ToString(), providerUserKey, email, String.Empty, password, _
                 isApproved, False, createdDt, lastLoginTime, lastLoginTime, DateTime.Now, _
                 DateTime.MaxValue)
            End If
        Next

        Return Nothing
    End Function

    ''' <summary>
    ''' Retrieves a username based on a matching email.
    ''' </summary>
    Public Overrides Function GetUserNameByEmail(ByVal email As String) As String
        Dim doc As New XmlDocument()
        doc.Load(_XmlFileName)

        For Each node As XmlNode In doc.GetElementsByTagName("User")
            If node.ChildNodes(2).InnerText.Equals(email.Trim(), StringComparison.OrdinalIgnoreCase) Then
                Return node.ChildNodes(0).InnerText
            End If
        Next

        Return Nothing
    End Function

    ''' <summary>
    ''' Updates a user. The username will not be changed.
    ''' </summary>
    Public Overrides Sub UpdateUser(ByVal user As MembershipUser)
        Dim doc As New XmlDocument()
        doc.Load(_XmlFileName)

        For Each node As XmlNode In doc.GetElementsByTagName("User")
            If node.ChildNodes(0).InnerText.Equals(user.UserName, StringComparison.OrdinalIgnoreCase) Then
                'If user.Comment.Length > 30 Then
                '    node.ChildNodes(1).InnerText = Encrypt(user.Comment)
                'End If
                node.ChildNodes(2).InnerText = user.Email
                node.ChildNodes(3).InnerText = user.LastLoginDate.ToString("yyyy-MM-dd HH:mm:ss")
                node.ChildNodes(4).InnerText = user.IsApproved
                node.ChildNodes(5).InnerText = user.CreationDate.ToString("yyyy-MM-dd HH:mm:ss")
                doc.Save(_XmlFileName)
                _Users(user.UserName) = user
            End If
        Next
    End Sub

#End Region

#Region "Helper methods"

    ''' <summary>
    ''' Builds the internal cache of users.
    ''' </summary>
    Private Sub ReadMembershipDataStore()
        SyncLock Me
            If _Users Is Nothing OrElse (_forceUpdate = Nothing Or _forceUpdate = True) Then
                _Users = New Dictionary(Of String, MembershipUser)(16, StringComparer.InvariantCultureIgnoreCase)
                Dim doc As New XmlDocument()
                doc.Load(_XmlFileName)
                Dim nodes As XmlNodeList = doc.GetElementsByTagName("User")

                For Each node As XmlNode In nodes
                    ' Provider name
                    ' Username
                    ' providerUserKey
                    ' Email
                    ' passwordQuestion
                    ' Comment
                    ' isApproved
                    ' isLockedOut
                    ' creationDate
                    ' lastLoginDate
                    ' lastActivityDate
                    ' lastPasswordChangedDate
                    ' lastLockoutDate
                    Dim user As New MembershipUser(Name, node("UserName").InnerText, node("UserName").InnerText, node("Email").InnerText, [String].Empty, node("Password").InnerText, _
                     node("IsApproved").InnerText, False, DateTime.Parse(node("Created").InnerText), DateTime.Parse(node("LastLoginTime").InnerText), DateTime.Parse(node("LastLoginTime").InnerText), DateTime.Now, _
                     New DateTime(1980, 1, 1))

                    _Users.Add(user.UserName, user)
                Next
                _forceUpdate = False
            End If
        End SyncLock
    End Sub

    ''' <summary>
    ''' Encrypts a string using the SHA256 algorithm.
    ''' </summary>
    Private Shared Function Encrypt(ByVal plainMessage As String) As String
        Dim data As Byte() = Encoding.UTF8.GetBytes(plainMessage)
        Using sha As HashAlgorithm = New SHA256Managed()
            Dim encryptedBytes As Byte() = sha.TransformFinalBlock(data, 0, data.Length)
            Return Convert.ToBase64String(sha.Hash)
        End Using
    End Function

#End Region

#Region "Unsupported methods"

    Public Overrides Function ResetPassword(ByVal username As String, ByVal answer As String) As String
        Throw New NotSupportedException()
    End Function

    Public Overrides Function UnlockUser(ByVal userName As String) As Boolean
        Throw New NotSupportedException()
    End Function

    Public Overrides Function FindUsersByEmail(ByVal emailToMatch As String, ByVal pageIndex As Integer, ByVal pageSize As Integer, ByRef totalRecords As Integer) As MembershipUserCollection
        Throw New NotSupportedException()
    End Function

    Public Overrides Function FindUsersByName(ByVal usernameToMatch As String, ByVal pageIndex As Integer, ByVal pageSize As Integer, ByRef totalRecords As Integer) As MembershipUserCollection
        Throw New NotSupportedException()
    End Function

    Public Overrides Function GetNumberOfUsersOnline() As Integer
        Throw New NotSupportedException()
    End Function

    Public Overrides Function ChangePasswordQuestionAndAnswer(ByVal username As String, ByVal password As String, ByVal newPasswordQuestion As String, ByVal newPasswordAnswer As String) As Boolean
        Throw New NotSupportedException()
    End Function

    Public Overrides Function GetPassword(ByVal username As String, ByVal answer As String) As String
        Throw New NotSupportedException()
    End Function

#End Region

End Class